home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok33.lha / SetTool / SetTool.mod < prev    next >
Text File  |  1993-08-15  |  2KB  |  69 lines
  1. (**********************************************************************
  2.  
  3.     :Program.    SetTool.mod
  4.     :Contents.   Modify default tool of project or disk icons
  5.     :Author.     Nicolas Benezan [bne]
  6.     :Address.    Postwiesenstr. 2, D7000 Stuttgart 60
  7.     :Phone.      711/333679
  8.     :Copyright.  Public Domain
  9.     :Language.   Modula-2
  10.     :Translator. M2Amiga A+L V3.3d
  11.     :History.    V1.0 [bne] 06.Feb.1990
  12.     :Usage.      Usage = "SetTool" IconName[".info"] [PathName].
  13.  
  14. **********************************************************************)
  15. MODULE SetTool;
  16.  
  17. FROM Arguments  IMPORT GetArg, NumArgs;
  18. FROM Arts       IMPORT returnVal;
  19. FROM Dos        IMPORT error;
  20. FROM Icon       IMPORT GetDiskObject, PutDiskObject, FreeDiskObject;
  21. FROM SmallInOut IMPORT WriteLn, WriteString;
  22. FROM Strings    IMPORT Compare, Delete;
  23. FROM SYSTEM     IMPORT ADR;
  24. FROM Workbench  IMPORT DiskObject, DiskObjectPtr, WBObjectType;
  25.  
  26. CONST
  27.   Usage = 'Usage: "SetTool" IconName[".info"] [PathName].';
  28.  
  29. VAR
  30.   Icon: DiskObjectPtr;
  31.   Name, Tool: ARRAY [0..79] OF CHAR;
  32.   Len: INTEGER;
  33.  
  34. PROCEDURE Error (Message: ARRAY OF CHAR);
  35.   BEGIN
  36.     WriteString (Message);
  37.     WriteLn;
  38.     returnVal:= error;
  39.   END Error;
  40.  
  41. BEGIN
  42.   GetArg (2, Tool, Len);
  43.   GetArg (1, Name, Len);
  44.   IF (NumArgs () >= 1) AND (Len < 80) THEN
  45.     IF (Len > 5) AND (Compare (Name, Len - 5, 5, ".info", FALSE) = 0) THEN
  46.       Delete (Name, Len - 5, 5);
  47.     END;
  48.     Icon:= GetDiskObject (ADR (Name));
  49.     IF Icon # NIL THEN
  50.       WITH Icon^ DO
  51.         IF (type = project) OR (type = disk) THEN
  52.           Icon^.defaultTool:= ADR (Tool);
  53.         ELSE
  54.           Error ("object of wrong type");
  55.         END;
  56.       END;
  57.       IF NOT PutDiskObject (ADR (Name), Icon) THEN
  58.         Error ("cannot replace icon file");
  59.       END;
  60.       FreeDiskObject (Icon);
  61.     ELSE
  62.       Error ("object not found");
  63.     END;
  64.   ELSE
  65.     Error (Usage);
  66.   END;
  67. END SetTool.
  68.  
  69.